Amiga Plus 1996 #3/Amiga Plus CD - 1996 - No. 3.iso/demo-versionen/databaseprofessional_v3.0/picbase/overview.rexx

OS/2 REXX Batch file | 1995-12-29 | 5KB | 221 lines

/* Overview.rexx, 21.12.95 Jörg Richter */
/* Stil 1 */

OPTIONS RESULTS

thumbsize = 156

ADDRESS DataBase

GetMaskSize
size = result
width = WORD(size,1)
height = WORD(size,2)
IF WORDS(size) = 3 THEN
  depth = WORD(size,3)
ELSE
  depth = 8

xoff = (width-((width%thumbsize)*thumbsize))%2
yoff = (height-((height%thumbsize)*thumbsize))%2

IF depth = 8 THEN
  LoadGadgets "PicBase/IdxGadgets/"
ELSE
  LoadGadgets "PicBase/IdxGadgetsGray/"

doit = 1
stext = "Bitte wählen Sie ..."

DO FOREVER
  IF doit = 1 THEN DO
    Current
    nr = result
    CALL Overview
  END
  WaitCommand stext
  command = result
  stext = "Bitte wählen Sie ..."
  doit = 0
  IF WORDS(command) > 1 THEN DO
    mx = WORD(command,1)
    my = WORD(command,2)
    qual = WORD(command,3)
    Current
    ds = result
    IF qual = 10 THEN DO /* Gadget */
      IF mx = 1 THEN DO /* <- */
        nr = nr - (width%thumbsize)*(height%thumbsize)
        IF nr < 1 THEN nr = 1
        Goto nr
        doit = 1
      END
      IF mx = 2 THEN /* -> */
        doit = 1
      IF mx = 8 THEN DO /* Abbruch */
        Goto nr
        Call Cancel
      END
      IF mx > 2 THEN DO
        WaitCommand "Bitte wählen Sie das Bild aus ..."
        command = result
        IF WORDS(command) > 1 THEN DO
          IF mx = 3 THEN qual = 0
          IF mx = 4 THEN qual = 2
          IF mx = 6 THEN qual = 3 /* DTP */
          IF mx = 5 THEN qual = 9 /* Info */
          IF mx = 7 THEN qual = 1
          mx = WORD(command,1)
          my = WORD(command,2)
        END
      END
    END
    IF (qual < 10) & (my < height) THEN DO
      select = nr + (mx-xoff)%thumbsize + ((my-yoff)%thumbsize)*(width%thumbsize)
      Goto select
      IF qual = 1 THEN /* SHIFT */
        Call Cancel
      ELSE DO
        IF qual = 0 THEN
          Execute 1
        IF qual = 3 THEN DO
          GetData $F1
          data = result
          pos = LastPos("/",data)
          CopyToClip LEFT(data,pos) || D2C(10) || SubStr(data,pos+1,Length(data)-pos)
          stext = "Bildname ins ClipBoard kopiert"
        END
        IF qual = 9 THEN DO
          GetData $F1
          fname = result
          GetData $F2
          fsize = result
          GetData $F3
          psize = result
          stext = fname || " (" || fsize || " KBytes, " || psize || ")"
        END
        IF qual = 2 THEN DO /* CTRL */
          GetData $F1
          fname = result
          Mark
          xx = ((mx-xoff)%thumbsize)*thumbsize+xoff
          yy = ((my-yoff)%thumbsize)*thumbsize+yoff
          IsMarked

          IF RC = 5 THEN DO
            Box xx-2 yy-2 thumbsize-7 thumbsize-6 1000
            color = 1
            stext = "Bild demarkiert"
            END
          ELSE DO
            Box xx-2 yy-2 thumbsize-7 thumbsize-6 1001
            color = 3
            stext = "Bild markiert"
            END
          fpos = MAX(LastPos("/",fname),LastPos(":",fname))
          fname = UPPER(SubStr(fname,fpos+1,Length(fname)-fpos))
          SetFont Helvetica.font 9 0
          Text xx+(thumbsize%2)-4 yy+thumbsize-12 color CENTER fname
          SetFont RESET 0
        END
        Goto ds
      END
    END
  END
  ELSE DO
    IF command = 27 | command = 0 THEN DO /* ESC */
      Goto nr
      Call Cancel
      END
    IF command = 79 THEN DO /* <- */
      nr = nr - (width%thumbsize)*(height%thumbsize)
      IF nr < 1 THEN nr = 1
      Goto nr
      doit = 1
      END
    IF command = 78 | command = 32 THEN /* -> */
      doit = 1
    END
END

EXIT


ShowPicture:

ARG xx yy .

GetData $F1
fname = result
GetData $F4
name = result

IsMarked
IF RC = 5 THEN DO
  Box xx-2 yy-2 thumbsize-7 thumbsize-6 1000
  color = 1
  END
ELSE DO
  Box xx-2 yy-2 thumbsize-7 thumbsize-6 1001
  color = 3
  END

LoadPic name xx yy CENTER
IF RC = 0 THEN DO
  picw = WORD(result,1)
  pich = WORD(result,2)
  Box xx+14+(120-picw)%2 yy+14+(120-pich)%2 picw+1 pich+1 1001
END

Current
xnr = result
fpos = MAX(LastPos("/",fname),LastPos(":",fname))
fname = UPPER(SubStr(fname,fpos+1,Length(fname)-fpos))
SetFont Helvetica.font 9 0
Text xx+(thumbsize%2)-4 yy+thumbsize-12 color CENTER fname
SetFont Helvetica.font 11 0
Text xx+4 yy+8 1 LEFT xnr
SetFont RESET 0

RETURN


Overview:

Display On
ClearMask
Display Off
x = xoff
y = yoff

weiter = 1

DO WHILE weiter = 1

  CALL ShowPicture x y
  x = x + thumbsize
  IF x > width-thumbsize THEN DO
    IF y < height-(thumbsize*2) THEN DO
      x = xoff
      y = y + thumbsize
      END
    ELSE
      weiter = 0
    END
  RightOne
  IF RC ~= 0 THEN
    weiter = 0

END

RETURN


Cancel:

Display On
LoadGadgets RESET
Show NEW
EXIT